HPAVC/HPAVC CD-ROM.iso/PRUS101.ZIP/FDIRBOX.PAS

Pascal/Delphi Source File | 1994-12-19 | 27KB | 1,034 lines

UNIT FDIRBOX;
 (***************************************************************************

         RELEASE 1.07 - as contained in the file PRUS101.LZH
                 by Paul Schubert, 2:244/1181.18,  GERMANY

               --------------------------------------------
                organized for Fido's PASCAL related echoes
               --------------------------------------------

    06/21/1994 to --/--/---- by Paul Schubert, 2:244/1181.18,  GERMANY


           As far as third party copyrights are not violated this
           source code is hereby placed to the public domain. Use
           it whatever way you want, but use AT YOUR OWN RISK.

           In case you should modify the source rather send your
           modifications to the unit's current organizer (see above for
           NM address) than to spread it on your own. This will help to
           keep the unit updated and grant a certain standard to all
           other users as well.

           The unit is currently still under work. So it might greatly
           benefit of your participation.

           Those who contributed to the following piece of source,
           listed in alphabethical order:
        ================================================================
           Orazio Czerwenka, Paul Schubert ...
        ================================================================
           YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.

           Credits in your own programs are owed to Paul Schubert who
           made his former stand alone unit DIRBOX a substantial part
           of the PRUSSG project.

 ***************************************************************************)

{$I FDEFINE.DEF} { Use the general include file for conditional defines and
               common compiler directives ... }

{$F+,R-,S-}  { ... and afterwards add the unit's specific defines }

INTERFACE


{.$DEFINE USEMOUSE}
{$DEFINE SPDISP} { 2 VERSCHIEDENE DISPLAY METHODEN SIND WÄHLBAR }


USES  FCRT         { for HIDECURSOR, NORMCURSOR and PUTCHARATR }
      ,FDOS
{$IFDEF USEMOUSE}
      ,MAUSI,KBD
{$ENDIF USEMOUSE}
      ,DOS
      ;


CONST ANZINCLUDE = 5;

      TANONSEL        : BYTE = $0F; { TEXTATTRIB non selected }
      TASELECT        : BYTE = $70; { TEXTATTRIB selected }
      TARAND          : BYTE = $1E; { border }
      TATITEL         : BYTE = $5E; { title }
      TATAGED         : BYTE = $0C; { tagged }
      TATAGEDS        : BYTE = $74; { tagged and selected }

      EXCLUDE         : ARRAY[1..ANZINCLUDE] OF STRING[12] = ('','','','','');
      INCLUDE         : ARRAY[1..ANZINCLUDE] OF STRING[12] = ('','','','','');
      SEARCHFOR       : STRING[12] = ' ';

      DIRMARK         : CHAR = #254;
      DRIVEMARK       : CHAR = #4;
      DIRDISPLAYMODE  : BYTE = 1;
      DRIVESALLOWED   : BOOLEAN = TRUE;
      DIRSALLOWED     : BOOLEAN = TRUE;

      EXITKEYS        : ARRAY[1..8] OF WORD = (0,0,0,0,0,0,0,0);
      EXITKEY         : BYTE = 0;

VAR   PRINTNAME       : PROCEDURE(S:STRING);


FUNCTION  SELECTFILE(PTH,NAME:STRING):STRING;


IMPLEMENTATION


CONST WWIDMAX    = 4;
      WHIGMAX    = 23;
      WWID       : BYTE = 3;   { window width }
      WHIG       : BYTE = 8;   { window height }
      ANZWID     : BYTE = 14;


TYPE  STR6       = STRING[6];
      STR12      = STRING[12];
      STR80      = STRING[80];
      DIRPTR     = ^DIRREC;
      DIRREC     = RECORD
        NAME       : STR12;
        ATTR       : BYTE;
        TIME,SIZE  : LONGINT;
        NEXT       : DIRPTR;
        TAG        : BOOLEAN;
      END;


VAR   SCR              : POINTER;
      WOM,WUM          : WORD;
      TAALT,XPOS,YPOS  : BYTE;
      AKTPATH          : STR80;
      AllDrives        : String[26];

{ ------------------------------- }

CONST EXTENDEDKEYS : BOOLEAN = FALSE;


FUNCTION READKEYWORD:WORD;
VAR   R  : REGISTERS;
BEGIN
  IF EXTENDEDKEYS THEN R.AH := $10 ELSE R.AH := 0;
  INTR($16,R);
  IF NOT EXTENDEDKEYS AND (R.AL = $E0) THEN R.AL := 0;
  READKEYWORD := R.AX;
END; { READKEYWORD }

PROCEDURE STUFFKEY(W:WORD); { put WORD into KEYBOARD BUFFER }
VAR   R    : REGISTERS;
BEGIN
  R.AH := 5;
  R.CX := W;
  INTR($16,R);
END; { STUFFKEY }

{ ------------------------------- }

FUNCTION  ATTRTOSTR(ATTR:BYTE):STR6;
VAR   ST  : STR6;
BEGIN { ATTRTOSTR }
  IF (ATTR AND READONLY ) = 0 THEN ST := '-' ELSE ST := 'R';
  IF (ATTR AND HIDDEN   ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'H';
  IF (ATTR AND ARCHIVE  ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'A';
  IF (ATTR AND SYSFILE  ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'S';
  IF (ATTR AND DIRECTORY) = 0 THEN ST := ST + '-' ELSE ST := ST + 'D';
  IF (ATTR AND VOLUMEID ) = 0 THEN ST := ST + '-' ELSE ST := ST + 'V';
  ATTRTOSTR := ST;
END; { ATTRTOSTR }


FUNCTION EXPAND(NAME : STR12):STR12;
VAR   A,B  : BYTE;
      S    : STR12;
BEGIN { EXPAND }
  A := POS('.',NAME);
  IF A > 1 THEN BEGIN
    S := '';
    FOR B := A TO 8 DO S := S + ' ';
    INSERT(S,NAME,A);
  END;
  EXPAND := NAME;
END; { EXPAND }


PROCEDURE READDIR(PATH:STRING;VAR FILES:WORD;VAR DIRS:WORD;VAR START:DIRPTR);
VAR   EINTRAG  : SEARCHREC;
      NEU      : DIRPTR;
      I        : WORD;
      DN       : DIRSTR;
      FN       : NAMESTR;
      FE       : EXTSTR;

PROCEDURE INSERTLIST(VAR ALT,NEU:DIRPTR);
VAR   P  : POINTER;
BEGIN
  IF ALT = NIL THEN BEGIN
{ sort to end of list }
    ALT := NEU;
  END ELSE BEGIN
    IF ALT^.NAME > NEU^.NAME { name ascending }
    THEN BEGIN
{ hook an entry into the list }
      P := ALT;
      ALT := NEU;
      NEU^.NEXT := P;
    END ELSE
{ repeat searching }
      IF ALT^.NEXT = NIL THEN BEGIN
{ end of list }
        ALT^.NEXT := NEU;
      END ELSE BEGIN
{ go on recursively }
        INSERTLIST(ALT^.NEXT,NEU);
      END;
  END;
END; { INSERTLIST }

FUNCTION TEST(VAR EINTRAG:SEARCHREC):BOOLEAN;
VAR   I  : BYTE;

FUNCTION WILL:BOOLEAN;
VAR   I  : BYTE;
BEGIN
  WILL := TRUE;
  IF INCLUDE[1] = '' THEN EXIT;
  WILL := FALSE;
  FOR I := 1 TO ANZINCLUDE DO BEGIN
    IF (INCLUDE[I] <> '') AND
       (POS(INCLUDE[I],EINTRAG.NAME) <> 0) THEN WILL := TRUE;
  END; { NEXT I }
END; { WILL }

BEGIN { TEST }
  TEST := FALSE;
  WITH EINTRAG DO BEGIN
    IF NOT WILL THEN EXIT;

    FOR I := 1 TO ANZINCLUDE DO BEGIN
      IF (EXCLUDE[I] <> '') AND
         (POS(EXCLUDE[I],NAME) <> 0) THEN EXIT;
    END; { NEXT I }
    TEST := (ATTR AND VOLUMEID) = 0;
  END; { WITH EINTRAG }
END; { TEST }

PROCEDURE SPEICHERN;
BEGIN
  IF (EINTRAG.ATTR = DIRECTORY) AND (EINTRAG.NAME[1] <> DRIVEMARK) THEN BEGIN
    IF LENGTH(EINTRAG.NAME) = 12 THEN DELETE(EINTRAG.NAME,9,1);
    IF EINTRAG.NAME = '..' THEN INSERT(' ',EINTRAG.NAME,1)
                           ELSE INSERT(DIRMARK,EINTRAG.NAME,1);
  END;
  IF MAXAVAIL < 50 THEN EXIT; {@@@ keep wolves away }
  NEW(NEU);
  WITH NEU^ DO BEGIN
    NAME := EINTRAG.NAME;
    ATTR := EINTRAG.ATTR;
    TIME := EINTRAG.TIME;
    SIZE := EINTRAG.SIZE;
    TAG  := FALSE;
    NEXT := NIL;
  END; { WITH }

  INSERTLIST(START,NEU);
END; { SPEICHERN }

BEGIN { READDIR }
  FILES := 0;
  DIRS  := 0;
  I := LENGTH(PATH);
  WHILE (I > 1) AND (PATH[I] <> '\') DO DEC(I);

  IF DRIVESALLOWED AND (I <= 3) THEN BEGIN
    EINTRAG.NAME := DRIVEMARK+'A:';
    FOR I := 1 TO LENGTH(AllDrives) DO BEGIN
      IF GETDRIVETYPE(Ord (AllDrives[I]) - Ord('A') + 1) <> dtError THEN BEGIN
        EINTRAG.NAME[2] := CHR(I+$40);
        EINTRAG.ATTR    := DIRECTORY;
        EINTRAG.SIZE    := -1; { a drive : no size }
        EINTRAG.TIME    := -1; { a drive : no date }
        INC(DIRS);
        SPEICHERN;
      END;
    END; { NEXT I }
  END;

  IF DIRSALLOWED THEN BEGIN
    FSPLIT(PATH,DN,FN,FE);
    FINDFIRST(DN+'*.*',DIRECTORY,EINTRAG);
    WHILE DOSERROR = 0 DO BEGIN
      IF ((EINTRAG.ATTR AND DIRECTORY) > 0) AND
         (EINTRAG.NAME <> '.') THEN BEGIN
           INC(DIRS);
           EINTRAG.SIZE := -1; { don't show size for directories }
           SPEICHERN;
         END;
      FINDNEXT(EINTRAG);
    END; { WHILE }
  END;

  FINDFIRST(PATH,ANYFILE AND NOT DIRECTORY,EINTRAG);
  WHILE DOSERROR = 0 DO BEGIN
    IF TEST(EINTRAG) THEN BEGIN
      INC(FILES);
      SPEICHERN;
    END;
    FINDNEXT(EINTRAG);
  END; { WHILE }
END; { READDIR }


PROCEDURE FREEDIR(VAR DP:DIRPTR);
BEGIN { FREEDIR }
  IF DP <> NIL THEN BEGIN
    FREEDIR(DP^.NEXT);
    DISPOSE(DP);
    DP := NIL;
  END;
END; { FREEDIR }


{3.12.94}
PROCEDURE GETANZWID;
BEGIN
  CASE DIRDISPLAYMODE OF
    2 : ANZWID := 23; { name, size }
    3 : ANZWID := 38; { name, size, date }
    4 : ANZWID := 45; { name, size, attributes, date }
  ELSE
    ANZWID := 14; { name only }
  END; { CASE DIRDISPLAYMODE }
END; { GETANZWID }


FUNCTION  SELECTDIRREC(START:DIRPTR;MAXANZ:WORD):DIRPTR;
TYPE  S2  = STRING[2];
VAR   SPALTE             : BYTE;
      I,PO,ZEILE,MAXAUS,
      AUSSCHN,NTAGS      : WORD;
      ANZAHL             : INTEGER;
      DX,DY,DXA,DYA      : INTEGER;
      ENDE               : BOOLEAN;
      CH2,CH1            : CHAR;
      MKB                : WORD ABSOLUTE CH1;
      ST,SR              : STRING[14];
      P                  : DIRPTR;
      POINTERLIST        : ARRAY[0..WWIDMAX,1..WHIGMAX] OF DIRPTR;
LABEL CALCULATE_WINDOW;

FUNCTION ZS2(NR:INTEGER):S2;
VAR   S  : S2;
BEGIN
  STR(NR:2,S);
  IF S[1] = ' ' THEN S[1] := '0';
  ZS2 := S;
END; { ZS2 }

PROCEDURE ZEIGNAME(P:DIRPTR);
VAR   DT   : DATETIME;
      TAM  : BYTE;
BEGIN
  TAM := TEXTATTR;
  IF P^.TAG THEN BEGIN
    IF TEXTATTR = TASELECT THEN TEXTATTR := TATAGEDS
                           ELSE TEXTATTR := TATAGED
  END;
  WITH P^ DO BEGIN
{@@@}
    IF (ATTR AND DIRECTORY) = DIRECTORY
      THEN ST := ' '+NAME+'\'
      ELSE ST := ' '+EXPAND(NAME);
    WRITE(ST,'':14-LENGTH(ST));
    IF DIRDISPLAYMODE >= 2 THEN BEGIN
      IF SIZE <> -1 THEN WRITE(SIZE:8)
                    ELSE WRITE('        ');
    END;
    IF (DIRDISPLAYMODE = 4) AND (P^.NAME[1] <> DRIVEMARK) THEN BEGIN
      WRITE(' '+ATTRTOSTR(ATTR));
    END;
    IF DIRDISPLAYMODE >= 3 THEN BEGIN
      IF (TIME <> 0) AND (TIME <> -1) THEN BEGIN
        UNPACKTIME(TIME,DT);
        WITH DT DO
          WRITE(' ',DAY:2,'.'+ZS2(MONTH)+'.'+ZS2(YEAR MOD 100)+
                 ' '+ZS2(HOUR)+':'+ZS2(MIN));
      END;
    END;
    IF DIRDISPLAYMODE <> 1 THEN WRITE(' ');
  END; { WITH P^ }
  TEXTATTR := TAM;
END; { ZEIGNAME }

PROCEDURE BILDAUFBAU;
VAR   S,Z  : WORD;
{$IFDEF SPDISP}
      I    : WORD;
{$ENDIF SPDISP}
BEGIN
  FILLCHAR(POINTERLIST,SIZEOF(POINTERLIST),0);
  P := START;
  FOR S := 1 TO AUSSCHN * SUCC(WWID) DO P := P^.NEXT;

  TEXTATTR := TANONSEL;
  S := 0; Z := 1;

{$IFDEF SPDISP}
(*
  CLRSCR;
*)
  FOR I := 1 TO AUSSCHN * WHIG DO P := P^.NEXT;
(*
  WHILE ( (P <> NIL) AND (S <= WWID) ) DO BEGIN
*)
  WHILE S <= WWID DO BEGIN
    GOTOXY(2+S*ANZWID,Z);
    IF P <> NIL THEN BEGIN
      POINTERLIST[S,Z] := P;
      ZEIGNAME(P);
      P := P^.NEXT;
    END ELSE CLREOL;
    INC(Z);
    IF Z > WHIG THEN BEGIN
      Z := 1;
      INC(S);
    END;
  END; { WHILE }
{$ELSE}
  WHILE ( (P <> NIL) AND (Z <= WHIG) ) DO BEGIN
    GOTOXY(2+S*ANZWID,Z);
    POINTERLIST[S,Z] := P;
    ZEIGNAME(P);

    P := P^.NEXT;
    INC(S);
    IF S > WWID THEN BEGIN
      S := 0;
      INC(Z);
      CLREOL;
    END;
  END; { WHILE }
  CLREOS;
{$ENDIF ELSEIF SPDISP}
END; { BILDAUFBAU }

PROCEDURE RECHTS; FORWARD;
PROCEDURE LINKS; FORWARD;

PROCEDURE AUFWAERTS;
BEGIN
  IF ZEILE > 1 THEN DEC(ZEILE)
  ELSE BEGIN
{$IFDEF SPDISP}
    IF (SPALTE+AUSSCHN) > 0 THEN BEGIN
      ZEILE := WHIG;
      LINKS;
      WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
    END;
{$ELSE}
    IF AUSSCHN > 0 THEN BEGIN
      DEC(AUSSCHN);
      BILDAUFBAU;
    END;
{$ENDIF ELSEIF SPDISP}
  END;
END; { AUFWAERTS }

PROCEDURE ABWAERTS;
BEGIN
  IF ZEILE < WHIG THEN BEGIN
    IF (POINTERLIST[SPALTE,SUCC(ZEILE)] <> NIL) THEN INC(ZEILE);
  END ELSE BEGIN
{$IFDEF SPDISP}
    ZEILE := 1;
    RECHTS;
{$ELSE}
    IF AUSSCHN < MAXAUS THEN BEGIN
      INC(AUSSCHN);
      BILDAUFBAU;
    END;
    WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
{$ENDIF ELSEIF SPDISP}
  END;
END; { ABWAERTS }

PROCEDURE RECHTS;
BEGIN
  IF SPALTE < WWID THEN BEGIN
    IF POINTERLIST[SUCC(SPALTE),ZEILE] <> NIL THEN INC(SPALTE);
  END ELSE BEGIN
{$IFDEF SPDISP}
    IF AUSSCHN < MAXAUS THEN BEGIN
      INC(AUSSCHN);
      BILDAUFBAU;
    END;
    WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
{$ELSE}
    SPALTE := 0;
    ABWAERTS;
{$ENDIF ELSEIF SPDISP}
  END;
END; { RECHTS }

PROCEDURE LINKS;
BEGIN
  IF SPALTE > 0 THEN DEC(SPALTE) ELSE BEGIN
{$IFDEF SPDISP}
    IF AUSSCHN > 0 THEN BEGIN
      DEC(AUSSCHN);
      BILDAUFBAU;
    END;
{$ELSE}
    IF (ZEILE + AUSSCHN) > 1 THEN BEGIN
      AUFWAERTS;
      SPALTE := WWID;
    END;
{$ENDIF ELSEIF SPDISP}
  END;
END; { LINKS }

PROCEDURE CURSHOME;
BEGIN
  ZEILE := 1;
  SPALTE := 0;
  IF AUSSCHN > 0 THEN BEGIN
    AUSSCHN := 0;
    BILDAUFBAU;
  END;
END; { CURSHOME }

PROCEDURE CURSEND;
BEGIN
  IF AUSSCHN < MAXAUS THEN BEGIN
    AUSSCHN := MAXAUS;
    BILDAUFBAU;
  END;
{$IFDEF SPDISP}
  ZEILE := 1;
  SPALTE := WWID;
  WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
  ZEILE := WHIG;
  WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
{$ELSE}
  ZEILE := WHIG;
  SPALTE := 0;
  WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
  SPALTE := WWID;
  WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
{$ENDIF ELSEIF SPDISP}
END; { CURSEND }

PROCEDURE SETCURSOR(PO:WORD);
BEGIN
{$IFDEF SPDISP}
  SPALTE :=      PO DIV WHIG ;
  ZEILE  := SUCC(PO MOD WHIG);
  WHILE SPALTE > WWID DO BEGIN
    DEC(SPALTE);
    INC(AUSSCHN);
  END;
{$ELSE}
  ZEILE := SUCC(PO DIV SUCC(WWID));
  SPALTE := PO MOD SUCC(WWID);
  WHILE ZEILE >= WHIG DO BEGIN
    DEC(ZEILE);
    INC(AUSSCHN);
  END;
{$ENDIF ELSEIF SPDISP}
END; { SETCURSOR }

FUNCTION SUCHE:BOOLEAN;
VAR   P,FP  : DIRPTR;
BEGIN
  PO := 0;
  P  := START;
  WHILE P^.NEXT <> NIL DO BEGIN
(* search for filename stored in SR *)
    IF P^.NAME < SR THEN BEGIN
      INC(PO);
      FP := P^.NEXT;
    END;
    P := P^.NEXT;
  END; { WHILE }
  SUCHE := ( COPY(FP^.NAME,1,LENGTH(SR)) = SR );

  ZEILE := SUCC(PO DIV SUCC(WWID));

  AUSSCHN := 0;
  SETCURSOR(PO);
  BILDAUFBAU;
END; { SUCHE }

PROCEDURE ZEIGESR;
VAR   TA  : BYTE;
BEGIN
{3.12.94}
  IF (LO(WINDMAX)-LO(WINDMIN)) <= 20 THEN EXIT;
  TA := TEXTATTR;
  TEXTATTR := TARAND;
  WINDOW(LO(WOM) + 2,HI(WOM)+2,LO(WUM),HI(WUM)+1);
  GOTOXY(2,SUCC(HI(WINDMAX)-HI(WINDMIN)));
  IF SR = '' THEN WRITE('════════════════════')
             ELSE WRITE(' '+SR+' ═');
  WINDOW(LO(WOM) + 2,HI(WOM)+3,LO(WUM),HI(WUM));
  TEXTATTR := TA;
END; { ZEIGESR }

PROCEDURE ALLTAGS(WAS:BOOLEAN);
VAR   P  : DIRPTR;
BEGIN
  NTAGS := 0;
  P := START;
  REPEAT
    IF (P^.ATTR AND (VOLUMEID OR DIRECTORY)) = 0 THEN BEGIN
      P^.TAG := WAS;
      IF WAS THEN INC(NTAGS);
    END;
    P := P^.NEXT;
  UNTIL P = NIL;
  BILDAUFBAU;
END; { ALLTAGS }

BEGIN { SELECTDIRREC }
  EXITKEY := 0;
  SELECTDIRREC := NIL;
  IF START = NIL THEN EXIT;
  SR := '';
  WINDOW(LO(WOM) + 2,HI(WOM)+3,LO(WUM),HI(WUM));

CALCULATE_WINDOW:
{3.12.94}
  GETANZWID;
  IF ANZWID >= (LO(WINDMAX) - LO(WINDMIN)) THEN BEGIN
    INC(DIRDISPLAYMODE);
    IF DIRDISPLAYMODE > 4 THEN DIRDISPLAYMODE := 1;
    GOTO CALCULATE_WINDOW;
  END;
  ZEILE := 1; SPALTE := 0; AUSSCHN := 0;

{3.12.94}
  WWID := PRED( PRED(LO(WINDMAX) - LO(WINDMIN) ) DIV ANZWID);
  PO := 0;
  P := START; ANZAHL := 1;
  WHILE P^.NEXT <> NIL DO BEGIN
(* search for filename stored in SEARCHFOR *)
    IF P^.NAME <= SEARCHFOR THEN PO := PRED(ANZAHL);
    INC(ANZAHL);
    P := P^.NEXT;
  END; { WHILE }
  IF P^.NAME <= SEARCHFOR THEN PO := PRED(ANZAHL);

  SETCURSOR(PO);

  ANZAHL := ANZAHL - (SUCC(WWID) * WHIG);
  IF ANZAHL < 1 THEN MAXAUS := 0 ELSE BEGIN
{$IFDEF SPDISP}
    MAXAUS := ANZAHL DIV WHIG;
    IF ANZAHL MOD WHIG > 0 THEN INC(MAXAUS);
{$ELSE}
    MAXAUS := ANZAHL DIV SUCC(WWID);
    IF ANZAHL MOD SUCC(WWID) > 0 THEN INC(MAXAUS);
{$ENDIF ELSEIF SPDISP}
  END;

  BILDAUFBAU;
  ENDE := FALSE;

  DX := 0;
  DY := 0;
  NTAGS := 0;
  REPEAT
    TEXTATTR := TASELECT;
    IF ZEILE = 0 THEN INC(ZEILE); { 3.12.94 WARUM DENN NUR ???? }
    GOTOXY(2+SPALTE*ANZWID,ZEILE);
    ZEIGNAME(POINTERLIST[SPALTE,ZEILE]);
{$IFDEF USEMOUSE}
    REPEAT
      GETMICKEYCOUNT(DXA,DYA);
      DX := DX + DXA;
      DY := DY + DYA;
      IF ABS(DY) > 6 THEN BEGIN
        IF DY < 0 THEN BEGIN
          STUFFKEY(72 SHL 8);
        END ELSE BEGIN
          STUFFKEY(80 SHL 8);
        END;
        DY := 0;
      END;
      IF ABS(DX) > 32 THEN BEGIN
        IF DX < 0 THEN BEGIN
          STUFFKEY(75 SHL 8);
        END ELSE BEGIN
          STUFFKEY(77 SHL 8);
        END;
        DX := 0;
      END;
    UNTIL KEYPRESSED OR MOUSEPRESSED;
    MKB := READKEYORBUTTON;
    IF LO(MKB) = $E0 THEN BEGIN
{ delete 'E0' for normal keyboard driver }
      MKB := MKB AND $FF00;
    END;

    IF MKB = MOUSELFT THEN MKB := 13; { left mousekey = <Ret> }
    IF MKB = MOUSERT  THEN MKB := 27; { right mousekey = <Esc> }
{$ELSE}
    MKB := READKEYWORD;
{$ENDIF USEMOUSE}
    FOR I := 1 TO 8 DO IF MKB = EXITKEYS[I] THEN BEGIN
      EXITKEY := I;
      MKB := 13{27};
    END;
    CASE CH1 OF
       ^I : BEGIN
              INC(DIRDISPLAYMODE);
              IF DIRDISPLAYMODE > 4 THEN DIRDISPLAYMODE := 1;
              GOTO CALCULATE_WINDOW;
            END;
       ^[ : BEGIN { ESC }
              SELECTDIRREC := NIL;
              ENDE := TRUE;
            END;
       ^T : ALLTAGS(TRUE);
       ^U : ALLTAGS(FALSE);
       ^M : BEGIN { ENTER }
              SELECTDIRREC := POINTERLIST[SPALTE,ZEILE];
              ENDE := TRUE;
            END;
       #8 : BEGIN
              SR := '';
              ZEIGESR;
            END;
      ' ' : WITH POINTERLIST[SPALTE,ZEILE]^ DO BEGIN
              IF (ATTR AND (VOLUMEID OR DIRECTORY)) = 0 THEN BEGIN
                TAG := NOT TAG;
                IF TAG THEN INC(NTAGS)
                       ELSE DEC(NTAGS);
                STUFFKEY(77 SHL 8);
              END;
              SR := '';
              ZEIGESR;
            END;
  #1..#31 : BEGIN END;
       #0 : BEGIN { function keys }
              IF (CH2 <> #73) AND (CH2 <> #81) THEN BEGIN
                GOTOXY(2+SPALTE*ANZWID,ZEILE);
                TEXTATTR := TANONSEL;
                ZEIGNAME(POINTERLIST[SPALTE,ZEILE]);
              END;
            END;
    ELSE

      SR := SR + UPCASE(CH1);
      IF NOT SUCHE THEN SR := '';
      ZEIGESR;
    END; { CASE CH1 }
    CASE CH2 OF
      #72 : BEGIN { UP }
              SR := '';
              AUFWAERTS;
              ZEIGESR;
            END;
      #80 : BEGIN { DOWN }
              SR := '';
              ABWAERTS;
              ZEIGESR;
            END;
      #75 : BEGIN { LEFT }
              SR := '';
              LINKS;
              ZEIGESR;
            END;
      #77 : BEGIN { RIGHT }
              SR := '';
              RECHTS;
              ZEIGESR;
            END;
      #73 : BEGIN { PG UP }
              SR := '';
              IF AUSSCHN > 0 THEN BEGIN
{$IFDEF SPDISP}
                IF AUSSCHN > PRED(WWID) THEN DEC(AUSSCHN,WWID)
                                        ELSE AUSSCHN := 0;
{$ELSE}
                IF AUSSCHN > PRED(WHIG) THEN DEC(AUSSCHN,PRED(WHIG))
                                        ELSE AUSSCHN := 0;
{$ENDIF ELSEIF SPDISP}
              END ELSE CURSHOME;
              BILDAUFBAU;
              ZEIGESR;
            END;
      #81 : BEGIN { PG DOWN }
              SR := '';
              IF AUSSCHN < MAXAUS THEN BEGIN
{$IFDEF SPDISP}
                INC(AUSSCHN,WWID);
                IF AUSSCHN > MAXAUS THEN AUSSCHN := MAXAUS;
                WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(ZEILE);
{$ELSE}
                INC(AUSSCHN,PRED(WHIG));
                IF AUSSCHN > MAXAUS THEN AUSSCHN := MAXAUS;
                WHILE POINTERLIST[SPALTE,ZEILE] = NIL DO DEC(SPALTE);
{$ENDIF ELSEIF SPDISP}
              END ELSE CURSEND;
              BILDAUFBAU;
              ZEIGESR;
            END;
      #71 : BEGIN { HOME }
              SR := '';
              CURSHOME;
              ZEIGESR;
            END;
      #79 : BEGIN { END }
              SR := '';
              CURSEND;
              ZEIGESR;
            END;
    END; { CASE CH2 }
  UNTIL ENDE;

  IF NTAGS > 0 THEN BEGIN
    P := START;
    REPEAT
{$V-}
      IF P^.TAG THEN PRINTNAME(AKTPATH+P^.NAME);
{$V+}
      P := P^.NEXT;
    UNTIL P = NIL;
  END;

  WINDOW(LO(WOM) + 2,HI(WOM)+2,LO(WUM),HI(WUM));
END; { SELECTDIRREC }


PROCEDURE SAVEWINDOW;
VAR   I  : INTEGER;

PROCEDURE LINIE;
VAR   WID : BYTE;
BEGIN
  WID := PRED(LO(WINDMAX) - LO(WINDMIN));
  PUTCHARATTR('═',TEXTATTR,WID);
  GOTOXY(WHEREX+WID,WHEREY);
END;

BEGIN
  WHIG := PRED( (HI(WINDMAX) - HI(WINDMIN) - 1) );
  WOM  := WINDMIN;
  WUM  := WINDMAX;
  TAALT := TEXTATTR;
  XPOS := WHEREX;
  YPOS := WHEREY;
  PUSHWINDOW;

  TEXTATTR := TARAND;
  GOTOXY(1,1);
  WRITE('╔');
  LINIE;
  WRITE('╗');
  FOR I := 2 TO (HI(WINDMAX) - HI(WINDMIN)) DO BEGIN
    GOTOXY(1,I); WRITE('║');
    GOTOXY(SUCC(LO(WINDMAX)-LO(WINDMIN)),I); WRITE('║');
  END;
  WRITE('╚');
  LINIE;
  PUTCHARATTR('╝',TEXTATTR,1);

  WINDOW(LO(WOM)+2,HI(WOM)+2,LO(WUM),HI(WUM));
END; { SAVEWINDOW }


PROCEDURE RESTOREWINDOW;
BEGIN
  POPWINDOW;
  WINDOW(SUCC(LO(WOM)),SUCC(HI(WOM)),SUCC(LO(WUM)),SUCC(HI(WUM)));

  GOTOXY(XPOS,YPOS);
  TEXTATTR := TAALT;
END; { RESTOREWINDOW }


FUNCTION  SELECTFILE(PTH,NAME:STRING):STRING;
VAR   EXECOM,FILEPTR  : DIRPTR;
      SP,I,WINDW      : BYTE;
      NFILES,NDIRS    : WORD;
      PATH,PM         : STRING;
      S1              : STRING[80];
      NS              : STRING[10];
      DIRECTORY       : BOOLEAN;
      SR              : SEARCHREC;
LABEL ENDE;

BEGIN { SELECTFILE }
  SELECTFILE := '';
{3.12.94}
  GETANZWID;
  WHILE (ANZWID+3) > (LO(WINDMAX) - LO(WINDMIN)) DO BEGIN
    IF LO(WINDMAX) < 78 THEN BEGIN
      INC(WINDMAX);
    END ELSE BEGIN
      IF LO(WINDMIN) > 1 THEN DEC(WINDMIN);
    END;
  END;
  WHILE (HI(WINDMAX) - HI(WINDMIN)) < 3 DO BEGIN
    IF HI(WINDMAX) < 25 THEN BEGIN
      INC(WINDMAX,$100);
    END ELSE BEGIN
      IF HI(WINDMIN) > 1 THEN DEC(WINDMIN,$100);
    END;
  END;

  SAVEWINDOW;

  EXECOM := NIL;
  IF PTH = '' THEN GETDIR(0,PATH) ELSE PATH := PTH;
  REPEAT
    IF PATH[LENGTH(PATH)] <> '\' THEN PATH := PATH + '\';
    FREEDIR(EXECOM);
    TEXTATTR := TANONSEL;
    CLRSCR;
    TEXTATTR := $4E;
    WRITE(' warten ');
    READDIR(PATH+NAME,NFILES,NDIRS,EXECOM);

    HIDECURSOR;
    STR(NFILES,NS);
    AKTPATH := PATH;
    WINDW := LO(WINDMAX) - LO(WINDMIN) - 2;
    IF (POS('.*',NAME) > 0) AND (INCLUDE[1] <> '') THEN BEGIN
      S1 := ' '+PATH+'*';
      I := 1;
      WHILE (I <= ANZINCLUDE) AND ( (LENGTH(S1)+5) < WINDW ) DO BEGIN
        IF (I > 1) AND (INCLUDE[I] <> '') THEN S1 := S1 + ',';
        S1 := S1 + INCLUDE[I];
        INC(I);
      END;
      IF I <= ANZINCLUDE THEN S1 := S1+'..';
    END ELSE BEGIN
      S1 := ' '+PATH+NAME;
    END;
{ 18.12.94 }
    IF LENGTH(S1) > WINDW THEN BEGIN
      SP := LENGTH(S1);
      WHILE (SP > 0) AND (S1[SP] <> '\') DO DEC(SP);
      IF SP > 1 THEN DEC(SP);
      WHILE (SP > 0) AND (S1[SP] <> '\') DO DEC(SP);
      IF SP > 4 THEN BEGIN
        DELETE(S1,4,SP-4);
        INSERT('..',S1,4);
      END;
    END;
    IF (LENGTH(S1)+LENGTH(NS)+7) < WINDW THEN S1 := S1 + +' '+NS+' Files ';
{ 3.12.94 }
    IF LENGTH(S1) > WINDW THEN S1 := NAME;

    TEXTATTR := TANONSEL; GOTOXY(1,1); CLREOL;
    GOTOXY((LO(WINDMAX)-LO(WINDMIN)-LENGTH(S1)+2) SHR 1,1);
    TEXTATTR := TATITEL;  WRITE(S1);

    FILEPTR := SELECTDIRREC(EXECOM,NFILES+NDIRS);
    NORMCURSOR;
    PM := PATH;

    IF FILEPTR = NIL THEN BEGIN
      IF (NFILES + NDIRS) = 0 THEN BEGIN
        TEXTATTR := TANONSEL;
        WRITELN(#7);
        CASE DOSERROR OF
(*
           3 : WRITELN(' Pfad nicht gefunden');
          18 : WRITELN(' keine Dateien gefunden');
        ELSE
          WRITELN('ungültiges Laufwerk');
        END;
        WRITELN(' Taste drücken');
*)
           3 : WRITELN(' Path not found');
          18 : WRITELN(' no files found');
        ELSE
          WRITELN('not a valid drive');
        END;
        WRITELN(' press any key');
{$IFDEF USEMOUSE}
        IF READKEYORBUTTON = 0 THEN;
{$ELSE USEMOUSE}
        IF READKEYWORD = 0 THEN;
{$ENDIF USEMOUSE}
      END;
{ <ESC> = cancel }
      GOTO ENDE;
    END;

    IF EXITKEY = 0 THEN BEGIN
      DIRECTORY := (FILEPTR^.ATTR AND DOS.DIRECTORY) <> 0;
{ NAME[1] = DRIVEMARK is a name of a drive }
      IF FILEPTR^.NAME[1] = DRIVEMARK THEN BEGIN
        PATH := COPY(FILEPTR^.NAME,2,PRED(LENGTH(FILEPTR^.NAME))) + '\';
        FINDFIRST(PATH+'*.*',ANYFILE,SR);
        IF NOT (DOSERROR IN [0,18]) THEN BEGIN
          WRITE(#7);
          PATH := PM;
        END;
      END ELSE BEGIN

{ DIRECTORIES are marked as NAME[1] = DIRMARK }
        IF (FILEPTR^.NAME[1] = DIRMARK) OR
           (FILEPTR^.NAME = ' ..')
        THEN BEGIN
          DELETE(FILEPTR^.NAME,1,1);
          IF (LENGTH(FILEPTR^.NAME) > 8) AND
             (POS('.',FILEPTR^.NAME) = 0) THEN INSERT('.',FILEPTR^.NAME,9);
        END;
        PATH := PATH + FILEPTR^.NAME;

        IF (FILEPTR^.NAME = '..') THEN BEGIN
          SP := LENGTH(PATH) - 3;
          PATH := COPY(PATH,1,SP);
          WHILE PATH[SP] <> '\' DO DEC(SP);
          PATH := COPY(PATH,1,PRED(SP));
        END;
      END;
    END ELSE BEGIN
      SEARCHFOR := FILEPTR^.NAME;
      IF (FILEPTR^.NAME[1] = DIRMARK) OR (FILEPTR^.NAME[1] = DRIVEMARK) THEN BEGIN
        SELECTFILE := PATH;
      END ELSE BEGIN
        SELECTFILE := PATH + FILEPTR^.NAME;
      END;
      GOTO ENDE;
    END; { IF EXITKEY = 0 }
  UNTIL (NOT DIRECTORY) OR (EXITKEY <> 0);
  SEARCHFOR := FILEPTR^.NAME;
  SELECTFILE := PATH;

ENDE:
  RESTOREWINDOW;
  FREEDIR(EXECOM);
END; { SELECTFILE }


PROCEDURE DUMMY(S:STRING);
BEGIN
END; { DUMMY }


BEGIN
  PRINTNAME := DUMMY;
  AllDrives := LogiCalDrives;
END.